﻿module EmitConverter

open Ast
open StateMonad
open EmitEnvironment
open EmitType
open System.Collections.Generic

let rec private emit_binary t1 t2 op = 
  match op with
  | Binary.Sum _ -> 
    EmitExpr.Add (t1, t2)
  | Binary.Minus ->
    EmitExpr.Sub (t1, t2)
  | Binary.Mul ->
    EmitExpr.Mul (t1, t2)
  | Binary.Div ->
    EmitExpr.Div (t1, t2)
  | Binary.Mod ->
    EmitExpr.Mod (t1, t2)
  | Binary.And ->
    EmitExpr.And (t1, t2)
  | Binary.Or ->
    EmitExpr.Or (t1, t2)
  | Binary.Min ->
    EmitExpr.Lt (t1, t2)
  | Binary.MinEq ->
    EmitExpr.Leq (t1, t2)
  | Binary.Greater ->
    EmitExpr.Gt (t1, t2)
  | Binary.GreaterEq ->
    EmitExpr.Geq (t1, t2)
  | Binary.Eq ->
    EmitExpr.Eq (t1, t2)
  | Binary.NotEq ->
    EmitExpr.Neq (t1, t2)

and emit_expr_location (loc : Ast.Location) t =
  state{
    match loc with
    | Location.Id name ->
      do! comment ("location " + name)
      let! t0 = get_t_qualified name
      do! emit (Emit.Expr ((EmitExpr.Id t0), t))
    | Location.Member (e1, name, ty) ->
      do! comment (sprintf "member %A.%s" e1 name)
      let (Type.Identifier _class) = ty.Value.Value
      do! emit_expr e1 t
      let! t' = get_t
      do! emit (Emit.Expr (EmitExpr.Eq (t, T_symbol.Null), t'))
      do! emit (Emit.Jmp (EmitJmp.Fjmp (t', NULL_POINTER)))
      do! free_t t'
      
      let! _class = get_class _class
      let layout_index = given_class_get_field_index name _class

      do! emit (Emit.Expr (EmitExpr.GetField(t, layout_index), t))
    | Location.Nth (e1, e2) ->
      do! comment (sprintf "nth %A[%A]" e1 e2)
      do! emit_expr e1 t
      let! t1 = get_t

      do! emit (Emit.Expr (EmitExpr.Eq (t, T_symbol.Null), t1))
      do! emit (Emit.Jmp (EmitJmp.Fjmp (t1, NULL_POINTER)))
      
      do! emit_expr e2 t1

      let! t_dim = get_t
      do! emit (Emit.Expr ((emit_binary t1 T_symbol.Zero Binary.GreaterEq), t_dim))
      do! emit (Emit.Jmp (EmitJmp.Tjmp (t_dim, ARRAY_OUT_OF_BOUNDS)))
      let! t_length = get_t
      do! emit (Emit.Expr (EmitExpr.Length(t), t_length))
      do! emit (Emit.Expr ((emit_binary t1 t_length Binary.Min), t_dim))
      do! emit (Emit.Jmp (EmitJmp.Tjmp (t_dim, ARRAY_OUT_OF_BOUNDS)))
      do! free_t t_dim
      do! free_t t_length

      do! emit (Emit.Expr (EmitExpr.ReadArray(t, t1), t))
      do! free_t t1
  }

and emit_stmt_assign (loc : Ast.Location) expr_to_set  =
  state{
    match loc with
    | Location.Id name ->
      do! comment (sprintf "assign %s = %A" name expr_to_set)
      let! t = get_t
      do! emit_expr expr_to_set t
      do! set_t_qualified name t
      do! free_t t
    | Location.Member (e0, name, ty) ->
      do! comment (sprintf "assign %A.%s = %A" e0 name expr_to_set)
      let (Type.Identifier _class) = ty.Value.Value
      let! t0 = get_t
      do! emit_expr e0 t0
      let! t1 = get_t
      do! emit_expr expr_to_set t1
      let! t' = get_t
      do! emit (Emit.Expr (EmitExpr.Eq (t0, T_symbol.Null), t'))
      do! emit (Emit.Jmp (EmitJmp.Fjmp (t', NULL_POINTER)))
      do! free_t t'

      let! _class = get_class _class
      let layout_index = given_class_get_field_index name _class

      do! emit (Emit.Stmt (EmitStmt.SetField(t0, layout_index, t1)))
      do! free_t t0
      do! free_t t1
    | Location.Nth (e0, e1) -> 
      do! comment (sprintf "assign %A[%A] = %A" e0 e1 expr_to_set)
      let! t0 = get_t
      do! emit_expr e0 t0
      let! t1 = get_t

      do! emit (Emit.Expr (EmitExpr.Eq (t0, T_symbol.Null), t1))
      do! emit (Emit.Jmp (EmitJmp.Fjmp (t1, NULL_POINTER)))

      do! emit_expr e1 t1
      let! t2 = get_t
      do! emit_expr expr_to_set t2

      let! t_dim = get_t
      do! emit (Emit.Expr ((emit_binary t1 T_symbol.Zero Binary.GreaterEq), t_dim))
      do! emit (Emit.Jmp (EmitJmp.Tjmp (t_dim, ARRAY_OUT_OF_BOUNDS)))
      let! t_length = get_t
      do! emit (Emit.Expr (EmitExpr.Length(t0), t_length))
      do! emit (Emit.Expr ((emit_binary t1 t_length Binary.Min), t_dim))
      do! emit (Emit.Jmp (EmitJmp.Tjmp (t_dim, ARRAY_OUT_OF_BOUNDS)))
      do! free_t t_dim
      do! free_t t_length
      do! emit (Emit.Stmt (EmitStmt.SetArray(t0, t1, t2)))
      do! free_t t0
      do! free_t t1
      do! free_t t2
  }

and emit_expr (expr : Ast.Expr) t =
  state {
  match expr with
    | Expr.Binary (e1, Binary.And, e2) ->    
      do! comment (sprintf "binary %A && %A" e1 e2)
      do! emit_expr e1 t
      let! label_f = new_label
      do! emit (Emit.Jmp (EmitJmp.Tjmp (t, label_f)))
      do! emit_expr e2 t
      do! emit (Emit.Jmp (EmitJmp.Tjmp (t, label_f)))
      do! emit (Emit.Expr (EmitExpr.Int 1, t))
      let! label = new_label
      do! emit (Emit.Jmp (EmitJmp.Jmp label))
      do! emit (Emit.Label label_f)
      do! emit (Emit.Expr (EmitExpr.Int 0, t))
      do! emit (Emit.Label label)

    | Expr.Binary (e1, Binary.Or, e2) ->
      do! comment (sprintf "binary %A || %A" e1 e2)
      do! emit_expr e1 t
      let! label_t = new_label
      do! emit (Emit.Jmp (EmitJmp.Fjmp (t, label_t)))
      do! emit_expr e2 t
      do! emit (Emit.Jmp (EmitJmp.Fjmp (t, label_t)))
      do! emit (Emit.Expr (EmitExpr.Int 0, t))
      let! label = new_label
      do! emit (Emit.Jmp (EmitJmp.Jmp label))
      do! emit (Emit.Label label_t)
      do! emit (Emit.Expr (EmitExpr.Int 1, t))
      do! emit (Emit.Label label)
    | Expr.Binary (e1, Binary.Sum is_sum, e2) when !is_sum = false ->
      do! comment (sprintf "string_concat %A %A" e1 e2)
      do! emit_direct_call "stringCat" [e1; e2] t (Some Type.String)
    | Expr.Binary (e1, op, e2) ->
      do! comment (sprintf "binary %A %A %A" e1 op e2)
      do! emit_expr e1 t
      let! t1 = get_t
      do! emit_expr e2 t1
      let box = emit_binary t t1 op
      do! free_t t1
      do! emit (Emit.Expr (box, t))
    | Expr.Unary (op, e1) ->
      do! emit_expr e1 t
      let! box = 
        state{
          match op with
          | Unary.Negative ->
            do! comment (sprintf "unary - %A" e1) 
            return EmitExpr.Neg t
          | Unary.Not ->
            do! comment (sprintf "unary ! %A" e1) 
            return EmitExpr.Not t
        }
      do! emit (Emit.Expr (box, t))
    | Expr.Literal _val ->
      do! comment (sprintf "literal %A" _val) 
      match _val with
      | Literal.Int i ->
        do! emit (Emit.Expr ((EmitExpr.Int i), t))
      | Literal.Str str ->
        do! emit (Emit.Expr ((EmitExpr.Str str), t))
      | Literal.Bool c ->
        do! emit (Emit.Expr ((EmitExpr.Int (if c then 1 else 0)), t))
      | Literal.Null ->
        do! emit (Emit.Expr (EmitExpr.Null, t))
    | Expr.Location loc -> 
      do! emit_expr_location loc t
    | Expr.Call call ->
      do! emit_call call t
    | Expr.Length e ->
      do! comment (sprintf "length %A.Length" e) 
      do! emit_expr e t

      let! t1 = get_t
      do! emit (Emit.Expr (EmitExpr.Eq (t, T_symbol.Null), t1))
      do! emit (Emit.Jmp (EmitJmp.Fjmp (t1, NULL_POINTER)))
      do! free_t t1

      do! emit (Emit.Expr (EmitExpr.Length(t), t))
    | Expr.New name ->
      do! comment (sprintf "new %s()" name)       
      do! emit (Emit.Expr ((EmitExpr.New name), t))
    | Expr.NewArray (ty, e) ->
      do! comment (sprintf "new %A[%A]" ty e) 
      do! emit_expr e t
      do! emit (Emit.Expr ((EmitExpr.NewArray (ty, t)), t))
    | Expr.This ->
      do! comment (sprintf "this") 
      do! emit (Emit.Expr ((EmitExpr.This), t))
  }

and emit_call (call : Ast.Call) t =
  state{
    match call with
    | Call.Call (Method.Method id, args) ->
      do! comment (sprintf "call this.%A(%A)" id args) 
      do! emit_function id args T_symbol.This t None
    | Call.Call (Method.Select ((Expr.Location (Location.Id loc)), name, ty), args) when loc = "Library" -> 
      do! comment (sprintf "call %A.%A(%A)" loc name args) 
      do! emit_direct_call name args t ty.Value
    | Call.Call (Method.Select (e, id, ty), args) ->
      do! comment (sprintf "call %A.%A(%A)" e id args) 
      do! emit_expr e t
      let! t' = get_t
      do! emit (Emit.Expr (EmitExpr.Eq (t, T_symbol.Null), t'))
      do! emit (Emit.Jmp (EmitJmp.Fjmp (t', NULL_POINTER)))
      do! free_t t'
      do! emit_function id args t t ty.Value
  }

and emit_direct_call id args t ty = 
  state{
    let arg_pred e =
      state{
        let! t = get_t
        do! emit_expr e t
        return t
      }
    let! args1 = mapM arg_pred args
    do! emit (Emit.Expr (EmitExpr.DirectCall ("__"+id, args1), t))
    for arg in args1 do
      do! free_t arg
  }

and emit_function id args first_arg t ty = 
  state{
    let arg_pred e =
      state{
        let! t = get_t
        do! emit_expr e t
        return t
      }
    let! args1 = mapM arg_pred args
    let! dispatch_vector_index = get_method_index id ty
    do! emit (Emit.Expr (EmitExpr.Call (dispatch_vector_index, first_arg :: args1), t))
    for arg in args1 do
      do! free_t arg
  }

and emit_stmt stmt =
  state{
    match stmt with
    | Stmt.While(e0, s, _) -> 
      do! comment (sprintf "while while(%A){%A}" e0 s) 
      let! (l_test, l_end) = new_while_label
      do! emit (Emit.Label l_test)
      let! t0 = get_t
      do! emit_expr e0 t0
      do! emit (Emit.Jmp (EmitJmp.Tjmp (t0, l_end)))
      do! free_t t0
      do! emit_stmt s
      do! emit (Emit.Jmp (EmitJmp.Jmp l_test))
      do! emit (Emit.Label l_end)
      do! exit_while
    | Stmt.If(e0, s, None, _) ->
      do! comment (sprintf "if if(%A){%A}" e0 s) 
      let! t0 = get_t
      do! emit_expr e0 t0
      let! l = new_label
      do! emit (Emit.Jmp (EmitJmp.Tjmp (t0, l)))
      do! free_t t0
      do! emit_stmt s
      do! emit (Emit.Label l)
    | Stmt.If(e0, s1, Some s2, _) ->
      do! comment (sprintf "if if(%A){%A} else {%A}" e0 s1 s2) 
      let! l_false = new_label 
      let! l_end = new_label
      let! t0 = get_t
      do! emit_expr e0 t0
      do! emit (Emit.Jmp (EmitJmp.Tjmp (t0, l_false)))
      do! free_t t0
      do! emit_stmt s1
      do! emit (Emit.Jmp (EmitJmp.Jmp l_end))
      do! emit (Emit.Label l_false)
      do! emit_stmt s2
      do! emit (Emit.Label l_end)
    | Stmt.Call (call : Ast.Call, _) ->
      let! t0 = get_t
      do! emit_call call t0
      do! free_t t0
    | Stmt.Assign (loc, e, _)->
      do! emit_stmt_assign loc e
    | Stmt.Break _ ->
      do! comment "break" 
      let! while_label_end = get_last_end_while_label
      do! emit (Emit.Jmp (EmitJmp.Jmp while_label_end))
    | Stmt.Continue _ -> 
      do! comment "continue" 
      let! while_label = get_last_start_while_label
      do! emit (Emit.Jmp (EmitJmp.Jmp while_label))
    | Stmt.Return (None, _) ->   
      do! comment "return;"       
      do! emit (Emit.Stmt EmitStmt.ReturnVoid)
    | Stmt.Return (Some e0, _) ->
      do! comment (sprintf "return %A" e0)
      let! t0 = get_t
      do! emit_expr e0 t0
      do! emit (Emit.Stmt (EmitStmt.Return t0))
      do! free_t t0
    | Stmt.Block block ->
      do! comment "block"       
      do! emit_block block
  }
and emit_block block =
  state{
    match block with
    | Block.Block(var_decl_lst, stmt_lst, _) ->
      do! enter_block block
      for var_decl in var_decl_lst do
        do! emit_vardecl var_decl
      for stmt in stmt_lst do
        do! emit_stmt stmt
      do! exit_block
  }
and emit_vardecl var_decl =
  let aux_emit_var_decl (var_decl : id * Option<Expr>) =
    state{
      match var_decl with
      | id, None ->
        return ()       
      | id, Some e0 ->
        let! t0 = get_t_qualified id
//        let! t1 = get_t
        do! emit_expr e0 t0
//        do! emit (Emit.Stmt (EmitStmt.Assign(t0, t1)))
//        do! free_t t1
    }
  state{
    let (VarDecl.VarDecl(ty, var_decl, vars_list, _)) = var_decl
    do! aux_emit_var_decl var_decl
    for var_decl in vars_list do
      do! aux_emit_var_decl var_decl
  }

let makeLIR (meth_b : Ast.Block) (b : SymbolTableTypes.BodyTable) label_c while_c =
  let state =   
    { Emit          = List<Emit>()
      ActualTable   = b.Block.Value
      L_counter     = label_c
      T_Symbols     = List<T_symbol>()
      While_counter = while_c
      Actual_while  = [] }
  do state.T_Symbols.Add(T_symbol.This)
  for alias in b.Aliases do
    let infos = alias.Alias.Split([|'$'|])
    let ordinal = infos.[1] |> int
    state.T_Symbols.Add({ IsUsed = true; Id = ordinal; IsArg = b.Args.ContainsKey(infos.[0]) })
  execute (emit_block meth_b) state |> snd